home *** CD-ROM | disk | FTP | other *** search
/ Programming Sound Cards / Programming Sound Cards.iso / sound_56 / voc2raw.pas < prev    next >
Pascal/Delphi Source File  |  1995-01-01  |  11KB  |  405 lines
  1. {$I-,V-,I-}
  2. {$M 8000,0,8000}
  3. program voc2raw;
  4.  
  5. uses dos,crt;
  6.  
  7. type Tar = array[0..64*1024-2] of byte;
  8.      Par = ^Tar;
  9.  
  10. var a,b:file;
  11.     an,bn:string;
  12.     l,p,c:longint;
  13.     help:boolean;
  14.     stereo:boolean;
  15.     sign:boolean;
  16.     _16bit:boolean;
  17.     db:boolean;
  18.     over:boolean;
  19.     count:byte;
  20.     i:byte;
  21.     dat:Par;
  22.  
  23.   procedure getdosmem(var p;len:word); { max memory = 64*1024 in our case ... }
  24.   var note:boolean;
  25.     begin
  26.       asm
  27.          mov     [note],0
  28.          les     di,p
  29.          mov     bx,len
  30.          shr     bx,4
  31.          mov     ah,48h
  32.          int     21h
  33.          jc      @@ende
  34.          mov     es:[di+2],ax
  35.          xor     ax,ax
  36.          mov     es:[di],ax
  37.          mov     [note],1
  38. @@ende:
  39.       end;
  40.       if not note then
  41.         begin
  42.           writeln(' Not enough free memory ! Program halted.');
  43.           close(a);
  44.           close(b);
  45.           halt;
  46.         end;
  47.     end;
  48.  
  49.   procedure checkfilenames;
  50.   var a,b,c:string;
  51.     begin
  52.       FSPLIT(an,a,b,c);  { a = path of VOCname
  53.                            b = name of VOC (without extention)
  54.                            c = extention }
  55.       if c='' then an:=a+b+'.VOC';
  56.       if db then c:='.INC' else c:='.RAW';
  57.       if bn='' then bn:=a+b+c;
  58.     end;
  59.  
  60.   procedure checkexist;
  61.   var f:file;
  62.       c:char;
  63.       i:integer;
  64.     begin
  65.       assign(f,an);
  66.       reset(f,1);
  67.       i:=IOResult;
  68.       if i=2 then
  69.         begin
  70.           writeln(' ',an,' does not exist ! Program halted.');
  71.           halt;
  72.         end;
  73.       if i=3 then
  74.         begin
  75.           writeln(' path of ',an,' does not exist ! Program halted.');
  76.           halt;
  77.         end;
  78.       close(f);
  79.       assign(f,bn);
  80.       reset(f,1);
  81.       i:=IOResult;
  82.       if i=3 then
  83.         begin
  84.           writeln(' path of ',bn,' does not exist ! Program halted.');
  85.           halt;
  86.         end;
  87.       IF not over and (i=0) then
  88.         begin
  89.           writeln(' File ',bn,' does allready exist. Overwrite ? (Y/N) ');
  90.           repeat c:=upcase(readkey) until c in ['Y','N'];
  91.           if c='N' then
  92.             begin
  93.               writeln(' Don''t overwrite it ! Program halted.');
  94.               halt;
  95.             end
  96.           else writeln(' Overwrite this file. ');
  97.         end;
  98.       close(f);
  99.     end;
  100.  
  101.   function upstr(s:string):string;
  102.   var i:byte;
  103.       t:string;
  104.     begin
  105.       t:='';
  106.       for i:=1 to length(s) do t:=t+upcase(s[i]);
  107.       upstr:=t;
  108.     end;
  109.  
  110.   procedure getparam(s:string);
  111.     begin
  112.       if (s='/H') or (s='/?') then help:=true;
  113.       if (s='/16') then _16bit:=true;
  114.       if (s='/S') then sign:=true;
  115.       if (s='/R') then stereo:=true;
  116.       if (s='/I') then db:=true;
  117.       if (s='/O') then over:=true;
  118.       if s[1]<>'/' then
  119.         begin
  120.           if count=0 then an:=s;
  121.           if count=1 then bn:=s;
  122.           inc(count);
  123.         end;
  124.     end;
  125.  
  126.   procedure writeRAW;
  127.   label mono8,stereo8,mono16,stereo16,aftersave,ende;
  128.   var by:byte;
  129.       wo,wo1:word;
  130.     begin
  131.       assign(b,bn);
  132.       rewrite(b,1);
  133.       asm
  134.         les     di,dat
  135.         mov     cx,word ptr [l]
  136.         mov     si,cx
  137.         dec     si
  138. @@loop: mov     al,es:[di]
  139.         mov     ah,es:[si]
  140.         { I know that code is ugly, but it works :) and I won't spend more
  141.           time with it ... }
  142.  
  143.         cmp     [sign],0
  144.         je      @@nosign
  145.         sub     al,128
  146.         sub     ah,128
  147. @@nosign:
  148.          cmp    [stereo],0
  149.          je     @@mono
  150.          mov    [wo],ax
  151.          cmp    [_16Bit],0
  152.          je     stereo8
  153.          mov    dh,al
  154.          xor    dl,dl
  155.          xor    al,al
  156.          mov    [wo],dx
  157.          mov    [wo1],ax
  158.          jmp    stereo16
  159. @@mono:  cmp    [_16bit],0
  160.          je     @@mono8
  161.          mov    ah,al
  162.          xor    al,al
  163.          mov    [wo],ax
  164.          jmp    mono16
  165. @@mono8: mov    [by],al
  166.          jmp    mono8
  167. aftersave:
  168.           inc   di
  169.           dec   si
  170.           loop  @@loop
  171.           jmp   ende
  172.       end;
  173. mono8:
  174.       asm
  175.         push    es
  176.         push    di
  177.         push    cx
  178.         push    si
  179.       end;
  180.       blockwrite(b,by,1);
  181.       asm
  182.         pop     si
  183.         pop     cx
  184.         pop     di
  185.         pop     es
  186.         jmp     aftersave
  187.       end;
  188. mono16:
  189.       asm
  190.         push    es
  191.         push    di
  192.         push    cx
  193.         push    si
  194.       end;
  195.       blockwrite(b,wo,2);
  196.       asm
  197.         pop     si
  198.         pop     cx
  199.         pop     di
  200.         pop     es
  201.         jmp     aftersave
  202.       end;
  203. stereo8:
  204.       asm
  205.         push    es
  206.         push    di
  207.         push    cx
  208.         push    si
  209.       end;
  210.       blockwrite(b,wo,2);
  211.       asm
  212.         pop     si
  213.         pop     cx
  214.         pop     di
  215.         pop     es
  216.         jmp     aftersave
  217.       end;
  218. stereo16:
  219.       asm
  220.         push    es
  221.         push    di
  222.         push    cx
  223.         push    si
  224.       end;
  225.       blockwrite(b,wo,2);
  226.       blockwrite(b,wo1,2);
  227.       asm
  228.         pop     si
  229.         pop     cx
  230.         pop     di
  231.         pop     es
  232.         jmp     aftersave
  233.       end;
  234. ende: close(b);
  235.     end;
  236.  
  237. procedure writeINC;
  238. var wo,w:word;
  239.     by:byte;
  240.     c:word;
  241.     cas:byte;
  242.     pos:byte;
  243.     z:text;
  244. procedure writeword(w:word);
  245.   begin
  246.     if pos=0 then
  247.       begin
  248.         write(z,#13#10'  dw ');pos:=10;
  249.       end
  250.     else write(z,',');
  251.     write(z,w:5);dec(pos);
  252.   end;
  253.  
  254. procedure writebyte(b:byte);
  255.   begin
  256.     if pos=0 then
  257.       begin
  258.         write(z,#13#10'  db ');pos:=16;
  259.       end
  260.     else write(z,',');
  261.     write(z,b:3);dec(pos);
  262.   end;
  263.  
  264.   begin
  265.     pos:=0;
  266.     assign(z,bn);
  267.     rewrite(z);
  268.     asm
  269.       mov       al,1
  270.       xor       ah,ah
  271.       cmp       [sign],0
  272.       je        @@nosign
  273.       or        ah,al
  274. @@nosign:
  275.       shl       al,1
  276.       cmp       [stereo],0
  277.       je        @@nostereo
  278.       or        ah,al
  279. @@nostereo:
  280.       shl       al,1
  281.       cmp       [_16bit],0
  282.       je        @@no16bit
  283.       or        ah,al
  284. @@no16bit:
  285.        mov      [cas],ah
  286.     end;
  287.     case cas of
  288.        4:{ 16bit yes ,stereo no ,sign no  }
  289.          for w:=0 to l-1 do
  290.            begin
  291.              wo:=256*dat^[w];
  292.              writeword(wo);
  293.            end;
  294.        6: { 16bit yes ,stereo yes ,sign no  }
  295.           for w:=0 to l-1 do
  296.            begin
  297.              wo:=256*dat^[w];
  298.              writeword(wo);
  299.              wo:=256*dat^[l-w-1];
  300.              writeword(wo);
  301.            end;
  302.        5: { 16bit yes ,stereo no ,sign yes  }
  303.           for w:=0 to l-1 do
  304.            begin
  305.              wo:=256*(dat^[w]-128);
  306.              writeword(wo);
  307.            end;
  308.        7: { 16bit yes ,stereo yes ,sign yes  }
  309.           for w:=0 to l-1 do
  310.            begin
  311.              wo:=256*(dat^[w]-128);
  312.              writeword(wo);
  313.              wo:=256*(dat^[l-w-1]-128);
  314.              writeword(wo);
  315.            end;
  316.        0: { 16bit no ,stereo no ,sign no  }
  317.           for w:=0 to l-1 do
  318.             writebyte(dat^[w]);
  319.        2: { 16bit no ,stereo yes ,sign no  }
  320.           for w:=0 to l-1 do
  321.             begin
  322.               by:=dat^[w];
  323.               writebyte(by);
  324.               by:=dat^[l-w-1];
  325.               writebyte(by);
  326.             end;
  327.        1: { 16bit no ,stereo no ,sign yes  }
  328.           for w:=0 to l-1 do
  329.            begin
  330.              by:=dat^[w]-128;
  331.              writebyte(by);
  332.            end;
  333.        3: { 16bit no ,stereo yes ,sign yes  }
  334.           for w:=0 to l-1 do
  335.             begin
  336.               by:=dat^[w]-128;
  337.               writebyte(by);
  338.               by:=dat^[l-w-1]-128;
  339.               writebyte(by);
  340.             end;
  341.     end;
  342.     close(z);
  343.   end;
  344.  
  345. begin
  346.   _16bit:=false;help:=false;stereo:=false;sign:=false;db:=false;count:=0;
  347.   over:=false;an:='';bn:='';
  348.   for i:=1 to paramcount do
  349.     getparam(upstr(paramstr(i)));
  350.   writeln(' ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄ ');
  351.   writeln(' █ VOC2RAW.EXE   Copyright (c) 1994 by Andre'' Baresel █ ');
  352.   writeln(' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ '#13#10);
  353.   if help or (paramcount=0) then
  354.     begin
  355.       writeln(' Not enough parameters. I wanna help you :) ....'#13#10);
  356.       writeln(' This is a li''l program to convert 8bit mono VOC files into RAW files.');
  357.       writeln(' What are RAW files you''ll ask. It''s just the sampledata without any header.'#13#10);
  358.       writeln(' What are the parameters ?');
  359.       writeln('    /I convert to a INCfile');
  360.       writeln('    /O no "Overwrite ? (Y/N)" question');
  361.       writeln('    /16 convert the 8 bit data into 16 bit (samplevalues*256) ');
  362.       writeln('    /S convert to signed data (values -128..127 or -32768..-32767 for 16bit)');
  363.       writeln('    /R convert to stereo data (right channel reversed)'#13#10);
  364.       writeln(' You can only convert good old 8bit mono VOCs with only one block, otherwise');
  365.       writeln(' you''ll get some problems. Because VOC2RAW only cutoff the first 32 byte header');
  366.       writeln(' and don''t check if there are other blocks - maximum size is 64 KB !');
  367.       writeln(' Usage: ');
  368.       writeln('     VOC2RAW <switch> VOCname<.VOC> <RAWname> ');
  369.       writeln('        - if no RAWname is given program creats "VOCname.RAW" ');
  370.       writeln('        - "*" is not allowed in VOCname (I was to lazy...)');
  371.       writeln('        - Default is a 8 bit unsigned mono RAW as output file');
  372.       write(' continue with any key ...');readkey;write(#13);clreol;
  373.       writeln(' Why use this program ? ');
  374.       writeln('    - as highlevel language (Pascal/C/Basic) programmer you can simply ');
  375.       writeln('      load a RAWfile an play it, without the knowledge of the VOC format ');
  376.       writeln('    - as ASM coder (what I prefer for speed reasons) you can use BINOBJ to');
  377.       writeln('      convert the RAW file into an OBJ file and then you can link it to your');
  378.       writeln('      code or you can include the INC-file (remember option /I) direct into');
  379.       writeln('      your source code'#13#10);
  380.       halt;
  381.     end;
  382.   checkfilenames;
  383.   writeln(' VOC file read from : ',an);
  384.   writeln(' RAW/INC file write to  : ',bn);
  385.   if sign or stereo or _16bit or db then writeln('Options :');
  386.   if sign then   writeln('  + signed');
  387.   if stereo then writeln('  + stereo');
  388.   if _16bit then writeln('  + 16 bit');
  389.   if db then     writeln('  + creat a INC-file');
  390.   if over then   writeln('  - no "overwrite" question');
  391.   checkexist;
  392.   if IORESULT<>0 then;
  393.   assign(a,an);
  394.   reset(a,1);
  395.   if ioresult<>0 then exit;
  396.   l:=filesize(a);p:=$19+7;
  397.   if l<p then begin writeln(' File to short ! Program halted.');halt end;
  398.   l:=l-p;if l>64*1024 then begin writeln(' File to large - convert only the first 64KB !');l:=64*1024 end;
  399.   getdosmem(dat,64*1024-1);
  400.   blockread(a,dat^,p);
  401.   blockread(a,dat^,l);
  402.   if db then writeINC else writeRAW;
  403.   close(a);
  404. end.
  405.